perm filename VECTOR.SAI[SYS,HE] blob sn#004170 filedate 1972-06-20 generic text, type T, neo UTF8
00100	REQUIRE "VECT[SYS,HE]" LOAD_MODULE;
00200		EXTERNAL SIMPLE PROCEDURE SCALE(REAL ARRAY R,A;REAL V);
00300		EXTERNAL SIMPLE PROCEDURE DIFFERENCE(REAL ARRAY R,A,B);
00400		EXTERNAL REAL SIMPLE PROCEDURE DOT(REAL ARRAY R,A);
00500		EXTERNAL SIMPLE PROCEDURE CROSS(REAL ARRAY R,A,B);
00600		EXTERNAL REAL SIMPLE PROCEDURE MAGNITUDE(REAL ARRAY R);
00700		EXTERNAL SIMPLE PROCEDURE UNIT(REAL ARRAY R,A);
00800		EXTERNAL SIMPLE PROCEDURE MOVEV(REAL ARRAY R,A);
00900		EXTERNAL SIMPLE PROCEDURE INVERT(REAL ARRAY T,R);
01000		EXTERNAL SIMPLE PROCEDURE IDENTITY(REAL ARRAY A);
01100		EXTERNAL SIMPLE PROCEDURE TIMES(REAL ARRAY R,A,B);
01200		EXTERNAL SIMPLE PROCEDURE PLUS(REAL ARRAY R,A,B);
01300		EXTERNAL SIMPLE PROCEDURE REDUCE(REAL ARRAY R);
01400		EXTERNAL SIMPLE PROCEDURE TRANSFORM(REAL ARRAY R,T,V);
01500		EXTERNAL SIMPLE PROCEDURE TRANSPOSE(REAL ARRAY R,A);
01600		EXTERNAL SIMPLE PROCEDURE RESET(REAL ARRAY R);
01700		EXTERNAL SIMPLE PROCEDURE MOVET(REAL ARRAY R,A);
01800		EXTERNAL SIMPLE PROCEDURE NORMALIZE(REAL ARRAY R,A);
01900		EXTERNAL REAL SIMPLE PROCEDURE INNER(REAL ARRAY A,B);
02000		REQUIRE "SAITRG[SYS,HE]" SOURCE_FILE;
02050		REQUIRE "UNDER[SYS,HE]"	LOAD_MODULE;
02075		EXTERNAL SIMPLE PROCEDURE UNDERFLOW(INTEGER I);
02100	
02200	DEFINE CRLF="'15&'12";
02300	DEFINE RAD="57.29577951";
02400	DEFINE PI="3.1415926535",PIBY2="1.5707963268",TPI="6.2831853070";
02500	SIMPLE PROCEDURE ROTATE(SAFE REAL ARRAY P,A,O;REAL TH);
02600		BEGIN SAFE OWN REAL ARRAY T[1:4];
02700		CROSS(T,O,A);
02710		UNIT(T,T);
02800		SCALE(T,T,MAGNITUDE(A)*SIND(TH));
02900		MOVEV(P,A);
03000		SCALE(P,P,COSD(TH));
03100		PLUS(P,P,T) END;
03200	
03300	REAL SIMPLE PROCEDURE ANGLE(SAFE REAL ARRAY P,A,O);
03400		BEGIN SAFE OWN REAL ARRAY T[1:4];
03500		CROSS(T,A,P);
03600		RETURN(RAD*ATAN2(DOT(O,T),DOT(A,P))) END;
03700	
03800	 INTEGER FORMAT_POINTER; SAFE INTEGER ARRAY FORMAT_STACK[0:5,0:1];
03900	 SIMPLE PROCEDURE POP_FORMAT;
04000	IF FORMAT_POINTER ≥ 0 THEN BEGIN
04100		SETFORMAT(FORMAT_STACK[FORMAT_POINTER,0],FORMAT_STACK[FORMAT_POINTER,1]);
04200		FORMAT_POINTER←FORMAT_POINTER-1
04300	END ELSE SETFORMAT(0,8);
04400	
04500	 SIMPLE PROCEDURE PUSH_FORMAT(INTEGER W,D);
04600	BEGIN	FORMAT_POINTER←FORMAT_POINTER+1;
04700		GETFORMAT(FORMAT_STACK[FORMAT_POINTER,0],FORMAT_STACK[FORMAT_POINTER,1]);
04800		SETFORMAT(W,D)
04900	END;
05000	
05100	SIMPLE PROCEDURE PVECT(STRING S;REAL ARRAY V);
05200	BEGIN INTEGER I;
05300	PUSH_FORMAT(7,2);
05400	OUTSTR(S);
05500	FOR I←1 STEP 1 UNTIL 4 DO OUTSTR(CVF(V[I]));
05600	OUTSTR(CRLF);
05700	POP_FORMAT;
05800	END;
05900	
06000	SIMPLE PROCEDURE PMAT(STRING S;REAL ARRAY T);
06100	BEGIN INTEGER I,J;
06200	PUSH_FORMAT(7,2);
06300	OUTSTR(S&CRLF);
06400	FOR I←1 STEP 1 UNTIL 4 DO BEGIN
06500	FOR J←1 STEP 1 UNTIL 4 DO OUTSTR(CVF(T[I,J]));
06600	OUTSTR(CRLF);
06700	END;
06800	OUTSTR(CRLF);
06900	POP_FORMAT;
07000	END;
07100	
07200	SIMPLE PROCEDURE CVV(REAL ARRAY R,A;INTEGER I);
07300	BEGIN	INTEGER K;
07400		FOR K←1 STEP 1 UNTIL 3 DO R[K]←A[K,I];
07500		R[4]←1.0;
07600	END;
07700	
07800	SIMPLE PROCEDURE CVC(REAL ARRAY A;INTEGER I;REAL ARRAY R);
07900	BEGIN	INTEGER K;
08000		FOR K←1 STEP 1 UNTIL 3 DO A[K,I]←R[K];
08100	END;
08200